home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
PBLIB1
/
PROGS
/
ZIP.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1994-05-03
|
3KB
|
107 lines
{$S-,R-,V-,I-,B-,F-}
{$M 20000,0,50000}
program ZIP;
uses Dos, PbMISC, PbDATA, PbPARMS, PbEXEC;
{
Description : Convenience shell for PKZIP for quick packing and cleanup.
Author : Howard Richoux
Date : 12/18/93
Last revised:
Application : IBM PC and compatibles, done in Turbo Pascal 7.0
Status : Placed in the Public Domain by HNR Software 1/29/94
Published in: none
Config Parameters meaning default
CLEANUP Cleanup temp and bak files 'NO'
PURGEZIP Purge the ZIP on \ZIP first 'YES'
ZIPDIR Place to store the ZIP files 'c:\zip\'
ZIPOPT update/recurse dirs/pathname '-urpo'
}
type PathName = string;
var s : string;
var StartDir : PathName; {Drive:directory to be archived}
ZIPDIR : PathName; {Place for PKZIP to put packed file}
ZIPOptions : string; {PKZIP command option flags }
CleanUpFlag : boolean; {Do/Don't erase junk files }
PurgeZIP : boolean; {purge ZIP file before writing to it}
Procedure ZipIt(WorkDir : PathName);
var s,dirtag,zname,opt : string;
i,err : integer;
begin
DirTag := AddBackSlash(WorkDir);
i := 1;
while i > 0 do
begin
i := POS('\',DirTag);
if (i > 0) and (i < length(dirtag)) then Delete(Dirtag,1,i)
else i := 0;
end;
if length(dirtag) > 0 then
begin
DirTag := DeleteBackSlash(DirTag);
zname := AddBackSlash(ZIPDIR)+dirtag;
opt := ZIPOptions + ' -x'+dirtag+'.zip';
if purgezip then erasefile(zname+'.zip');
writeln('options [',opt,']');
if ZIPFile(opt,zname,'*.*',false) then
begin
s := 'PKUNZIP -t ' + AddBackSlash(ZIPDIR) + DirTag;
Err := ExecuteCommand(s);
if Err > 0 then writeln('PKUNZIP start failed ',Err)
end
else DisplayZIPError;
s := 'DDIR ' + DeleteBackSlash(ZIPDIR);
writeln(s);
Err := ExecuteCommand(s);
if Err > 0 then writeln('DDIR start failed ',Err);
end;
end;
Procedure Initialize;
begin
{Set default search parameters}
GetDir(0,StartDir);
writeln('Default directory: ',Startdir);
AddParm(1,'CLEANUP','NO');
AddParm(1,'PURGEZIP','YES');
AddParm(1,'ZIPDIR','c:\zip\');
AddParm(1,'ZIPOPT','-urpo ');
StandardpVarsInit;
ZIPDIR := GetParmStr('ZIPDIR');
ZIPOptions := GetParmStr('ZIPOPT');
CleanUpFlag := CheckOK('CLEANUP');
PurgeZIP := CheckOK('PURGEZIP');
writeln(' Save Area: ',ZIPDIR);
end;
begin {MAIN}
pProgID := 'ZIP 1.20';
Initialize;
if CleanUpFlag then
begin
if GetParmStr('CLEANUP1') <> '' then
ParmCleanUp(StartDir)
else DefaultCleanUp(StartDir);
ShowEraseStats;
writeln('');
end;
ZipIt(StartDir);
end.